home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 027a / agraph.zip / AGRAPH.PRG next >
Text File  |  1991-05-16  |  14KB  |  428 lines
  1. * Compile with /n option
  2.  
  3. * The following constant determines the density of y axis labels
  4. #define YDENSITY 80
  5. #define BAR 1
  6. #define LINE 2
  7. static _xOrg,_yOrg,_width,_height,_yMin,_yMax
  8. static _xDivs,_xInc,_yDivs,_yScale,_decimals,_GraphType := 0
  9.  
  10. ************************************************************************
  11. * Auto Clustered Bar Graphing Function
  12. *
  13. * Parameters:
  14. * All parameters other than data are optional
  15. *
  16. * data    contains an array of data values.  If more than one group is
  17. *         desired (i.e., clustered bars) the array should contain an
  18. *         array of arrays, where each sub array contains the data points
  19. *         for each cluster.
  20. * width   Width of graph in screen units.
  21. * height  Height of graph in screen units.
  22. * xOrg    x position of lower left corner.
  23. * yOrg    y position of lower left corner.
  24. * attr    array of {pattern, color}, used for groups.  The size should
  25. *         be the same as each of the data sub arrays.
  26. * yMin    override for y minimum
  27. * yMax    override for y maximum
  28. ************************************************************************
  29. procedure ACBarGraph(data,width,height,xOrg,yOrg,attr,yMin,yMax)
  30. local i,j
  31.  
  32. AutoCommon(@data,@width,@height,@xOrg,@yOrg,@yMin,@yMax)
  33. // Determine scaling values
  34. _xInc := int(_width/_xDivs)
  35. _yScale := _height/(_yMax-_yMin)
  36. _width := _xInc*_xDivs                  // adjust width
  37.  
  38. // Scale and store the data.
  39. datareset()
  40. for i := 1 to _xDivs
  41.   for j := 1 to len(data[i])
  42.     datastore((data[i,j]-yMin)*_yScale, ;
  43.               if(attr==nil,j,attr[j,1]), ;
  44.               0, ;
  45.               if(attr==nil,j,attr[j,2]))
  46.   next j
  47. next i
  48.  
  49. // Draw the graph
  50. clipwin(_xOrg,_yOrg,_xOrg+_width,_yOrg+_height)
  51. bargraph(_xOrg+_xInc/(2*len(data[1])+2),_yOrg,_xInc,2,len(data[1]))
  52. clipwin(0,0,1350,1000)
  53. _GraphType := BAR
  54. return
  55.  
  56. ************************************************************************
  57. * Auto Clustered 3D Bar Graphing Function
  58. *
  59. * Parameters:
  60. * All parameters other than data are optional
  61. *
  62. * data    contains an array of data values.  If more than one group is
  63. *         desired (i.e., clustered bars) the array should contain an
  64. *         array of arrays, where each sub array contains the data points
  65. *         for each cluster.
  66. * width   Width of graph in screen units.
  67. * height  Height of graph in screen units.
  68. * xOrg    x position of lower left corner.
  69. * yOrg    y position of lower left corner.
  70. * attr    array of {pattern, color}, used for groups.  The size should
  71. *         be the same as each of the data sub arrays.
  72. * yMin    override for y minimum
  73. * yMax    override for y maximum
  74. ************************************************************************
  75. procedure ACBar3DGraph(data,width,height,xOrg,yOrg,attr,yMin,yMax)
  76. local i,j
  77.  
  78. AutoCommon(@data,@width,@height,@xOrg,@yOrg,@yMin,@yMax)
  79. // Determine scaling values
  80. _xInc := int(_width/_xDivs)
  81. _yScale := _height/(_yMax-_yMin)
  82. _width := _xInc*_xDivs                  // adjust width
  83.  
  84. // Scale and store the data.
  85. datareset()
  86. for i := 1 to _xDivs
  87.   for j := 1 to len(data[i])
  88.     datastore((data[i,j]-yMin)*_yScale, ;
  89.               if(attr==nil,j,attr[j,1]), ;
  90.               0, ;
  91.               if(attr==nil,j,attr[j,2]))
  92.   next j
  93. next i
  94.  
  95. // Draw the graph
  96. clipwin(_xOrg,_yOrg,_xOrg+_width,_yOrg+_height)
  97. bargraph(_xOrg+_xInc/(2*len(data[1])+2),_yOrg,_xInc,2+16,len(data[1]))
  98. clipwin(0,0,1350,1000)
  99. _GraphType := BAR
  100. return
  101.  
  102. ************************************************************************
  103. * Auto Stacked Bar Graphing Function
  104. *
  105. * Parameters:
  106. * All parameters other than data are optional
  107. *
  108. * data    contains an array of data values.  If more than one group is
  109. *         desired (i.e., clustered bars) the array should contain an
  110. *         array of arrays, where each sub array contains the data points
  111. *         for each cluster.
  112. * width   Width of graph in screen units.
  113. * height  Height of graph in screen units.
  114. * xOrg    x position of lower left corner.
  115. * yOrg    y position of lower left corner.
  116. * attr    array of {pattern, color}, used for groups.  The size should
  117. *         be the same as each of the data sub arrays.
  118. * yMin    override for y minimum
  119. * yMax    override for y maximum
  120. ************************************************************************
  121. procedure ASBarGraph(data,width,height,xOrg,yOrg,attr,yMin,yMax)
  122. local i,j,t
  123.  
  124. if len(data[1]) > 1                     // add an extra sum group
  125.   for i := 1 to len(data)
  126.     t := 0
  127.     for j := 1 to len(data[i])
  128.       t += data[i,j]
  129.     next j
  130.     aadd(data[i],t)
  131.   next i
  132. end
  133. AutoCommon(@data,@width,@height,@xOrg,@yOrg,@yMin,@yMax)
  134.  
  135. if len(data[1]) > 1                    // kill sum group
  136.   for i := 1 to len(data)
  137.     asize(data[i],len(data[i])-1)
  138.   next
  139. end
  140.  
  141. // Determine scaling values
  142. _xInc := int(_width/_xDivs)
  143. _yScale := _height/(_yMax-_yMin)
  144. _width := _xInc*_xDivs                  // adjust width
  145.  
  146. // Scale and store the data.
  147. datareset()
  148. for i := 1 to _xDivs
  149.   for j := 1 to len(data[i])
  150.     datastore((data[i,j]-yMin)*_yScale, ;
  151.               if(attr==nil,j,attr[j,1]), ;
  152.               0, ;
  153.               if(attr==nil,j,attr[j,2]))
  154.   next j
  155. next i
  156.  
  157. // Draw the graph
  158. clipwin(_xOrg,_yOrg,_xOrg+_width,_yOrg+_height)
  159. bargraph(_xOrg+_xInc/4,_yOrg,_xInc,1,len(data[1]))
  160. clipwin(0,0,1350,1000)
  161. _GraphType := BAR
  162. return
  163.  
  164. ************************************************************************
  165. * Auto Stacked 3D Bar Graphing Function
  166. *
  167. * Parameters:
  168. * All parameters other than data are optional
  169. *
  170. * data    contains an array of data values.  If more than one group is
  171. *         desired (i.e., clustered bars) the array should contain an
  172. *         array of arrays, where each sub array contains the data points
  173. *         for each cluster.
  174. * width   Width of graph in screen units.
  175. * height  Height of graph in screen units.
  176. * xOrg    x position of lower left corner.
  177. * yOrg    y position of lower left corner.
  178. * attr    array of {pattern, color}, used for groups.  The size should
  179. *         be the same as each of the data sub arrays.
  180. * yMin    override for y minimum
  181. * yMax    override for y maximum
  182. ************************************************************************
  183. procedure ASBar3DGraph(data,width,height,xOrg,yOrg,attr,yMin,yMax)
  184. local i,j,t
  185.  
  186. if len(data[1]) > 1                     // add an extra sum group
  187.   for i := 1 to len(data)
  188.     t := 0
  189.     for j := 1 to len(data[i])
  190.       t += data[i,j]
  191.     next j
  192.     aadd(data[i],t)
  193.   next i
  194. end
  195. AutoCommon(@data,@width,@height,@xOrg,@yOrg,@yMin,@yMax)
  196.  
  197. if len(data[1]) > 1                    // kill sum group
  198.   for i := 1 to len(data)
  199.     asize(data[i],len(data[i])-1)
  200.   next
  201. end
  202.  
  203. // Determine scaling values
  204. _xInc := int(_width/_xDivs)
  205. _yScale := _height/(_yMax-_yMin)
  206. _width := _xInc*_xDivs                  // adjust width
  207.  
  208. // Scale and store the data.
  209. datareset()
  210. for i := 1 to _xDivs
  211.   for j := 1 to len(data[i])
  212.     datastore((data[i,j]-yMin)*_yScale, ;
  213.               if(attr==nil,j,attr[j,1]), ;
  214.               0, ;
  215.               if(attr==nil,j,attr[j,2]))
  216.   next j
  217. next i
  218.  
  219. // Draw the graph
  220. clipwin(_xOrg,_yOrg,_xOrg+_width,_yOrg+_height)
  221. bargraph(_xOrg+_xInc/4,_yOrg,_xInc,1+16,len(data[1]))
  222. clipwin(0,0,1350,1000)
  223. _GraphType := BAR
  224. return
  225.  
  226. ************************************************************************
  227. * Auto Line Graphing Function
  228. *
  229. * Parameters:
  230. * All parameters other than data are optional
  231. *
  232. * data    Contains an array of data values.  If more than one group is
  233. *         desired (i.e., multiple lines) the array should contain an
  234. *         array of arrays, where each sub array contains the data points
  235. *         for each data set.
  236. * width   Width of graph in screen units.
  237. * height  Height of graph in screen units.
  238. * xOrg    x position of lower left corner.
  239. * yOrg    y position of lower left corner.
  240. * attr    Array of {icon, color}, used for sets.  The size should be the
  241. *         same as each of the data sub arrays.
  242. * yMin    Override for y minimum
  243. * yMax    Override for y maximum
  244. ************************************************************************
  245. procedure ALineGraph(data,width,height,xOrg,yOrg,attr,yMin,yMax)
  246. local i,j,drawflag,x,y
  247.  
  248. AutoCommon(@data,width,height,xOrg,yOrg,yMin,yMax)
  249. // Determine scaling values
  250. _xInc := _width/(_xDivs-1)
  251. _yDivs := int(_height/YDENSITY+.5)      // number of y axis divisions
  252. _decimals := tic(@_yMin,@_yMax,@_yDivs)
  253. _yScale := _height/(_yMax-_yMin)
  254.  
  255. clipwin(_xOrg,_yOrg,_xOrg+_width,_yOrg+_height)
  256. // Scale and graph the data.
  257. for i := 1 to len(data[1])
  258.   drawflag := .F.
  259.   for j := 1 to _xDivs
  260.     if data[j,i] == nil                 // stop drawing at nil data
  261.       drawflag := .F.
  262.     else
  263.       x := _xOrg+(j-1)*_xInc
  264.       y := _yOrg+(data[j,i]-_yMin)*_yScale
  265.       if (x>=0 .and. x<=1350 .and. y>=0 .and. y<=1000)
  266.         drawicon(x,y,4,if(attr==nil,i,attr[i,1]),if(attr==nil,i,attr[i,2]))
  267.       end
  268.       drawline(x,y,x,y,if(drawflag,16,0),0,if(attr==nil,i,attr[i,2]))
  269.       drawflag := .T.
  270.     end
  271.   next j
  272. next i
  273. clipwin(0,0,1350,1000)
  274.  
  275. _GraphType := LINE
  276.  
  277. return
  278.  
  279.  
  280. procedure ALabel(xLabels,LColor)
  281. local i
  282. if LColor = nil
  283.   LColor := 15                          // default to White
  284. end
  285.  
  286. if _GraphType == 0                      // Abort if no previous graph
  287.   return
  288. end
  289. if _GraphType == BAR
  290.   xyaxes(_xOrg,_yOrg,_xInc*_xDivs,_height,_xDivs,_yDivs,0,LColor)
  291. else
  292.   xyaxes(_xOrg,_yOrg,_width,_height,_xDivs-1,_yDivs,0,LColor)
  293. endif
  294.  
  295. // Draw y axis labels
  296. if (_xOrg-15>=0 .and. _xOrg-15<=1350)
  297.   for i := 0 to _yDivs
  298.     if _yOrg+i*_height/_yDivs>=0 .and. _yOrg+i*_height/_yDivs<=1000
  299.       saystring(_xOrg-15,_yOrg+i*_height/_yDivs,4,0+16+64,LColor,;
  300.                 str(_yMin+i*(_yMax-_yMin)/_yDivs,10,_decimals))
  301.     end
  302.   end
  303. end
  304.  
  305. // Draw x axis labels
  306. if _yOrg-15>=0 .and. _yOrg-15<=1000 .and. xlabels <> nil
  307.   for i := 1 to _xDivs
  308.     if _GraphType == BAR
  309.       if _xOrg+i*_xInc-_xInc/2>=0 .and. _xOrg+i*_xInc-_xInc/2<=1350
  310.         saystring(_xOrg+i*_xInc-_xInc/2,_yOrg-15,4,0+8+128,LColor,;
  311.                 trim(xlabels[i]))
  312.       end
  313.     else
  314.       if _xOrg+(i-1)*_xInc>=0 .and. _xOrg+(i-1)*_xInc<=1350
  315.         saystring(_xOrg+(i-1)*_xInc,_yOrg-15,4,0+8+128,LColor,;
  316.                 trim(xlabels[i]))
  317.       end
  318.     end
  319.   next i
  320. end
  321. return
  322.  
  323. procedure AutoCommon(data,width,height,xOrg,yOrg,yMin,yMax)
  324. ************************************************************************
  325. * This is stuff we need common to all the autograph routines
  326. ************************************************************************
  327. // Fill in missing parameter values
  328. if xOrg == nil .and. width == nil
  329.   width := 1000
  330. end
  331. if yOrg == nil .and. height == nil
  332.   height = 800
  333. end
  334. do case
  335.   case xOrg == nil
  336.     xOrg := 675 - width / 2
  337.   case width == nil
  338.     width := 1350 - 2 * xOrg
  339. end
  340. do case
  341.   case yOrg == nil
  342.     yOrg := 500 - height / 2
  343.   case height == nil
  344.     height := 1000 - 2 * yOrg
  345. end
  346.  
  347. _xDivs := len(data)
  348. // Make sure data contains an array of arrays
  349. for i := 1 to _xDivs
  350.   data[i] := if(VALTYPE(data[i])='A',data[i],{data[i]})
  351. next
  352. // Determine yMin and yMax if not specified
  353. if yMin == nil
  354.   yMin := data[1,1]
  355.   AEVAL(data,{|group| AEVAL(group, ;
  356.     {|value| if(value<>nil,yMin:=min(yMin,value), )})})
  357. end
  358. if yMax == nil
  359.   yMax := data[1,1]
  360.   AEVAL(data,{|group| AEVAL(group, ;
  361.     {|value| if(value<>nil,yMax:=max(yMax,value), )})})
  362. end
  363. _yDivs := int(height/YDENSITY+.5)       // number of y axis divisions
  364. _decimals := tic(@yMin,@yMax,@_yDivs)
  365.  
  366. _width := width
  367. _height := height
  368. _xOrg := xOrg
  369. _yOrg := yOrg
  370. _yMin := yMin
  371. _yMax := yMax
  372.  
  373. return
  374.  
  375.  
  376. ************************************************************************
  377. * Compute tic interval and adjust min & max
  378. * Parameters:
  379. *   min0    minimum value of data set
  380. *   max0    maximum value of data set
  381. *   n       requested number of axis divisions
  382. * On return (if parameters passed by reference):
  383. *   min0    adjusted minimum value
  384. *   max0    adjusted maximum value
  385. *   n       adjusted number of axis divisions
  386. * Return value is decimal precision necessary for divisions
  387. ************************************************************************
  388. function tic(min0,max0,n)
  389. local a := { {1,0}, {2,0}, {2.5,1}, {5,0} }
  390. local i:=1,e,n1,min1,max1
  391. * compute exponent of interval
  392.   e := 10 ^ floor(log10((max0-min0)/n))
  393.   do while .T.
  394.     min1 := floor(min0/(a[i,1]*e)) * a[i,1]*e   // adjust min
  395.     max1 := ceiling(max0/(a[i,1]*e)) * a[i,1]*e // adjust max
  396.     n1 := int((max1-min1) / (a[i,1]*e))         // how many divs this one?
  397.     if n1 <= n
  398.       exit
  399.     end
  400.     if ++i > len(a)
  401.       i := 1
  402.       e := e * 10
  403.     end
  404.   end
  405.   min0 := min1
  406.   max0 := max1
  407.   n := (max0-min0)/(a[i,1] * e)
  408.   return(max(a[i,2]-floor(log10(e)),0))
  409.  
  410. ************************************************************************
  411. * Returns highest integer <= x
  412. ************************************************************************
  413. function floor(x)
  414. return if(x<int(x),int(x)-1,int(x))
  415.  
  416. ************************************************************************
  417. * Returns lowest integer >= x
  418. ************************************************************************
  419. function ceiling(x)
  420. return if(x>int(x),int(x)+1,int(x))
  421.  
  422. ************************************************************************
  423. * Returns Base10 Logarithm
  424. ************************************************************************
  425. function log10(x)
  426. return (log(x)/log(10))
  427.  
  428.